home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / butt01.zip / BTEST.PRG < prev    next >
Text File  |  1993-01-04  |  11KB  |  321 lines
  1. * Program.: BTEST.PRG
  2. * Author..: Charles Alan Butler    
  3. * Date....: 04/04/90
  4. * Notice..: Copyright (c) 1990,MIS Consulting, All Rights Reserved
  5. * Notes...: Template Button Menu Ver(1) 4/4/90 *CAB*
  6. * Notes...: Target Language is FoxBase Version 2.1 .
  7. ****  Debug  *****
  8. DO set_fox
  9. DO mis_logo
  10. ****  Debug  *****
  11. ** -- Save some of the calling environment
  12. SAVE SCREEN TO ButtScrn
  13. ButtColor=SYS(2001,"COLOR")  &&  SAVE Colors     [Fox 2.1]
  14. Null = SYS(2002)        &&  Turn the cursor off  [Fox 2.1]
  15. **  --  Declare private variables
  16. PRIVATE ButRef,ButtColor,ButtScrn,cnt,ColorStr,LastColor
  17. PRIVATE Mpt,MaxMpt,SayString
  18.  
  19. DIMENSION GroupFlag(17)
  20. **  Flag Groups as follows
  21. **  Value of  1 to n  = Radio Button Groups
  22. **  Value of  0 = Check Box
  23. **  Value of -1 = Proceed Text Button
  24. **  Value of -2 = Abort Text Button
  25. **  Value of -3 = Menu Choice Text Button
  26. GroupFlag( 1)=1     &&  Button Group
  27. GroupFlag( 2)=1     &&  Button Group
  28. GroupFlag( 3)=2     &&  Button Group
  29. GroupFlag( 4)=2     &&  Button Group
  30. GroupFlag( 5)=3     &&  Button Group
  31. GroupFlag( 6)=3     &&  Button Group
  32. GroupFlag( 7)=3     &&  Button Group
  33. GroupFlag( 8)=4     &&  Button Group
  34. GroupFlag( 9)=4     &&  Button Group
  35. GroupFlag(10)=4     &&  Button Group
  36. GroupFlag(11)=0     &&  Check Box
  37. GroupFlag(12)=0     &&  Check Box
  38. GroupFlag(13)=0     &&  Check Box
  39. GroupFlag(14)=0     &&  Check Box
  40. GroupFlag(15)=-3    &&  Menu Item
  41. GroupFlag(16)=-1    &&  Proceed
  42. GroupFlag(17)=-2    &&  ESCape
  43.  
  44. **  Set true defaults, one per Radio Group
  45. IF TYPE('T_F(17)') # 'L'  && Skip if already defined   RELEASE T_F
  46.    PUBLIC T_F(17)
  47.    T_F( 2)=.T.   &&  Button Group 1
  48.    T_F( 3)=.T.   &&  Button Group 2
  49.    T_F( 5)=.T.   &&  Button Group 3
  50.    T_F( 9)=.T.   &&  Button Group 4
  51.    T_F(11)=.T.   &&  Check Box
  52. ENDIF
  53.  
  54. IF TYPE('Ky') # 'N'  && Skip if already defined
  55.    RELEASE Ky
  56.    PUBLIC Ky         &&  Returns the ASCII number of the exit key
  57. ENDIF
  58.  
  59. DIMENSION SayAry(17)    &&  --  Array Used to Display Choices  --
  60. DIMENSION HotKey(17)    &&  --  Array Used to Display Hot Keys  --
  61. SayAry( 1)='@  8,19 SAY "( ) ALL         "'
  62. HotKey(1) = "A23r+/n"
  63. SayAry( 2)='@  9,19 SAY "( ) Select      "'
  64. SayAry( 3)='@  8,41 SAY "( ) Incomplete Jobs"'
  65. SayAry( 4)='@  9,41 SAY "( ) All Jobs       "'
  66. HotKey(4) = "J49r+/n"
  67. SayAry( 5)='@ 12,19 SAY "( ) Subdivision "'
  68. SayAry( 6)='@ 13,19 SAY "( ) Address     "'
  69. SayAry( 7)='@ 14,19 SAY "( ) Job Number  "'
  70. SayAry( 8)='@ 12,41 SAY "( ) Printer        "'
  71. HotKey(8) = "P45r+/n"
  72. SayAry( 9)='@ 13,41 SAY "( ) Screen         "'
  73. SayAry(10)='@ 14,41 SAY "( ) File           "'
  74. SayAry(11)='@ 17,19 SAY "[ ] Balance Due"'
  75. SayAry(12)='@ 18,19 SAY "[ ] Phone Number"'
  76. HotKey(12) = "o25gr+/n"
  77. SayAry(13)='@ 17,41 SAY "[ ] Projected Bala"'
  78. SayAry(14)='@ 18,41 SAY "[ ] Projected Cost"'
  79. SayAry(15)='@ 19,31 SAY "{Menu Button}"'
  80. HotKey(15) = "M32w+/n"
  81. SayAry(16)='@ 20,22 SAY "« PROCEED »"'
  82. SayAry(17)='@ 20,45 SAY "< CANCEL >"'
  83. HotKey(17) = "C47w+/n"
  84. HotKeys = "A..J...P...O..M.C"
  85.  
  86. **  --  Color of Menu Choice  --
  87. DIMENSION SayColor(17)
  88. SayColor( 1)='BG+/N'
  89. SayColor( 2)='BG+/N'
  90. SayColor( 3)='BG+/N'
  91. SayColor( 4)='BG+/N'
  92. SayColor( 5)='BG+/N'
  93. SayColor( 6)='BG+/N'
  94. SayColor( 7)='BG+/N'
  95. SayColor( 8)='BG+/N'
  96. SayColor( 9)='BG+/N'
  97. SayColor(10)='BG+/N'
  98. SayColor(11)='BR+/N'
  99. SayColor(12)='BR+/N'
  100. SayColor(13)='BR+/N'
  101. SayColor(14)='BR+/N'
  102. SayColor(15)='R+/N'
  103. SayColor(16)='GR+/N'
  104. SayColor(17)='GR+/N'
  105.  
  106. * --- Paints titles & borders on the screen
  107. SET COLOR TO G+/N
  108. @ 6,16,21,62 BOX "╔═╗║╝═╚║ "
  109. @  6,23 SAY "[ Projection Report Print Options ]"
  110. SET COLOR TO W+/N
  111. @  7,19 SAY "*- Contractors -*"
  112. @  7,41 SAY "*- Job Selection -*"
  113. @ 11,43 SAY "*- Output To -*"
  114. @ 11,20 SAY "*- Sort By -*"
  115. @ 16,26 SAY "*- Include In Report -*"
  116. **  --  Local Variables
  117. Mpt = 1        &&  Menu Pointer
  118. MptMax = 17    &&  Last Menu Choice
  119. LastColor=''   &&  Last Color Set
  120.  
  121. cnt =1
  122. DO WHILE cnt <= MptMax        &&  Display Menu Choices
  123.    IF GroupFlag(cnt) < 0      &&  Re-set text button flags
  124.       T_F(cnt) = .F.
  125.    ENDIF
  126.    IF GroupFlag(cnt) >= 0
  127.       SayAry(cnt)=STUFF(SayAry(cnt),15,1,IIF(T_F(cnt),IIF(GroupFlag(cnt)=0,'X','*'),' '))
  128.    ENDIF
  129.    ColorStr = SayColor(cnt)
  130.    IF LastColor # ColorStr
  131.       SET COLOR TO &ColorStr
  132.       LastColor = ColorStr
  133.    ENDIF
  134.    SayString = SayAry(cnt)
  135.    &SayString
  136.    IF SUBSTR(HotKeys,cnt,1) # '.'      &&  Display Hot Key
  137.       ColorStr = SUBSTR(HotKey(cnt),4)
  138.       SET COLOR TO &ColorStr
  139.       @ ROW(),VAL(SUBSTR(HotKey(cnt),2,2)) SAY SUBSTR(HotKey(cnt),1,1)
  140.       LastColor = ColorStr
  141.    ENDIF
  142.  
  143.    cnt = cnt +1
  144. ENDDO
  145.  
  146. DO WHILE .T.
  147.    **  ----------  Display Highlite and get key press  ------------
  148.    SET COLOR TO w+/r
  149.    SayString = SayAry(Mpt)
  150.    &SayString                &&  Display Highlite
  151.    Ky = INKEY(0)             &&  Get Key Press   ******************
  152.    ColorStr = SayColor(Mpt)  &&  Color
  153.    SET COLOR TO &ColorStr
  154.    &SayString                &&  Turn Highlite Off
  155.    IF SUBSTR(HotKeys,Mpt,1) # '.'      &&  Display Hot Key
  156.       ColorStr = SUBSTR(HotKey(Mpt),4)
  157.       SET COLOR TO &ColorStr
  158.       @ ROW(),VAL(SUBSTR(HotKey(Mpt),2,2)) SAY SUBSTR(HotKey(Mpt),1,1)
  159.       LastColor = ColorStr
  160.    ENDIF
  161.  
  162.    **  --  Test for Hot Key  --
  163.    IF Ky > 32 .AND. Ky < 127     &&  ASCII key pressed
  164.       IF Ky > 96
  165.          Ky = Ky -32 &&  Convert to Upper Case
  166.       ENDIF
  167.       IF CHR(Ky) $ HotKeys       &&  Hot Key found
  168.          Mpt = AT(CHR(Ky),HotKeys)
  169.          Ky =32
  170.       ENDIF
  171.    ENDIF
  172.  
  173.    **  ----------------  Process KEY strokes  ---------------------
  174.    DO CASE
  175.    CASE Ky=5.OR.Ky=56.OR.Ky=19.OR.Ky=52            &&  [Up]  [Left]
  176.       Mpt = IIF(Mpt=1,MptMax,Mpt-1)
  177.  
  178.    CASE Ky=24.OR.Ky=50.OR.Ky=4.OR.Ky=54            &&  [Down]  [Right]
  179.       Mpt = IIF(Mpt=MptMax,1,Mpt+1)
  180.  
  181.    CASE Ky = 9                                     &&  Tab to next group
  182.       cnt = Mpt
  183.       ButRef = GroupFlag(Mpt)
  184.       DO WHILE cnt <= MptMax
  185.          IF GroupFlag(cnt) # ButRef
  186.             Mpt = cnt
  187.             EXIT
  188.          ENDIF
  189.          cnt = cnt +1
  190.       ENDDO
  191.       Mpt = IIF(cnt>MptMax,1,Mpt)
  192.  
  193.    CASE Ky = 15                                    &&  Shift Tab prev group
  194.       cnt = Mpt
  195.       ButRef = GroupFlag(Mpt)
  196.       DO WHILE cnt >= 1
  197.          IF GroupFlag(cnt) # ButRef
  198.             Mpt = cnt
  199.             EXIT
  200.          ENDIF
  201.          cnt = cnt -1
  202.       ENDDO
  203.       Mpt = IIF(cnt<1,MptMax,Mpt)
  204.  
  205.    CASE Ky = 27                                    &&  ESCape
  206.       T_F(17) = .T.
  207.          do MsgError with 'w+/r',24,'This is a test call upon Escape exit.'
  208.       EXIT     &&  --  MENU Exit to abort
  209.  
  210.    CASE Ky = 23 .OR. Ky = 10                       &&  Ctrl-End or Ctrl-Enter
  211.       Ky = 10     &&  Force to Ctrl-Enter code
  212.       T_F(16) = .T.
  213.       EXIT     &&  --  MENU Exit to proceed
  214.  
  215.    CASE Ky=28.OR.Ky=72.OR.Ky=104                   &&  [F1] [Hh]  Help
  216.       **  put up the window
  217.       SET COLOR TO RB+/N
  218.       SAVE SCREEN TO F1Screen
  219.       @ 6,10,21,66 BOX '╔═╗║╝═╚║ '
  220.       @ 6,27 SAY '[ Control Panel Help ]'
  221.       @ ROW()+1,12 SAY 'The following keys are active while using this panel.'
  222.       @ ROW()+1,12 SAY '--------KEY------ACTION------------------------------'
  223.       @ ROW()+1,12 SAY '      [Enter]  Select the item highlighted.'
  224.       @ ROW()+1,12 SAY '      [Space]  Select the item highlighted.'
  225.       @ ROW()+1,12 SAY '[Ctrl][Enter]  Exit the menu and proceed.'
  226.       @ ROW()+1,12 SAY '  [Ctrl][End]  Exit the menu and proceed.'
  227.       @ ROW()+1,12 SAY '        [ESC]  Exit without selecting.'
  228.       @ ROW()+1,12 SAY '     [Arrows]  Up/Down, move the highlighted item.'
  229.       @ ROW()+1,12 SAY '     [Arrows]  Right/Left, move the highlighted item.'
  230.       @ ROW()+1,12 SAY '        [Tab]  Move Highlight forward one group'
  231.       @ ROW()+1,12 SAY ' [Shift][Tab]  Move Highlight back one group'
  232.       @ ROW()+1,12 SAY '       [Home]  Go to the first item.'
  233.       @ ROW()+1,12 SAY '        [End]  Go to the last item.'
  234.       @ ROW()+1,12 SAY '         [F1]  Displays this screen.'
  235.       @ ROW()+1,12+14 SAY '<Press Any Key To Return>'
  236.       cnt=INKEY(0)    &&  wait for key press
  237.       RESTORE SCREEN FROM F1Screen
  238.  
  239.    CASE Ky = 1 .OR. Ky = 55                        &&  Home
  240.       Mpt = 1
  241.  
  242.    CASE Ky = 6 .OR. Ky = 49                        &&  End
  243.       Mpt = MptMax
  244.  
  245.    CASE Ky = 13 .OR. Ky = 32                       &&  ENTER or SPACE
  246.       IF GroupFlag(Mpt) >= 0   &&  Is Button or Check Box
  247.          **  No action if Button is ON
  248.          IF GroupFlag(Mpt) = 0 .OR. .NOT. T_F(Mpt)
  249.  
  250.             DO CASE      &&  Tag Action Initiated Here
  251.             CASE Mpt=1
  252.                SAVE SCREEN TO ButScrn
  253.                do nothing
  254.                RESTORE SCREEN FROM ButScrn
  255.             CASE Mpt=4
  256.                SAVE SCREEN TO ButScrn
  257.                DO Msg24 with "This is a test call to Msg24.Prg from a button."
  258.                ans=Inkey(5)
  259.                RESTORE SCREEN FROM ButScrn
  260.             CASE Mpt=8
  261.                SAVE SCREEN TO ButScrn
  262.                Do Nothing
  263.                RESTORE SCREEN FROM ButScrn
  264.             CASE Mpt=12
  265.                SAVE SCREEN TO ButScrn
  266.                Do Msg24 with "This is a test call to Msg24.prg from a check box."
  267.                ans=Inkey(5)
  268.                RESTORE SCREEN FROM ButScrn
  269.             ENDCASE
  270.  
  271.             **  Set True / False Flag
  272.             T_F(Mpt) = IIF(GroupFlag(Mpt)#0,.T.,.NOT.T_F(Mpt))
  273.  
  274.             **  Set  display of button On or Off
  275.             SayAry(Mpt)=STUFF(SayAry(Mpt),15,1,IIF(T_F(Mpt),IIF(GroupFlag(Mpt)=0,'X','*'),' '))
  276.  
  277.             **  If Button, Need to clear all buttons in this group
  278.             IF GroupFlag(Mpt) # 0   && Ignore if Check Box
  279.                ButRef= GroupFlag(Mpt)   &&  Button Reference
  280.                cnt =1
  281.                DO WHILE cnt <= MptMax
  282.                   IF GroupFlag(cnt) = ButRef      &&  Button group match
  283.                      IF cnt # Mpt      &&  Clear Button
  284.                         T_F(cnt) = .F.
  285.                         SayAry(cnt)=STUFF(SayAry(cnt),15,1,' ')
  286.                      ENDIF
  287.                      ColorStr = SayColor(cnt)
  288.                      IF LastColor # ColorStr
  289.                         SET COLOR TO &ColorStr
  290.                         LastColor = ColorStr
  291.                      ENDIF
  292.                      SayString = LEFT(SayAry(cnt),15)+'"'
  293.                      &SayString             &&  Display Menu Choice
  294.                   ENDIF
  295.                   cnt = cnt +1
  296.                ENDDO
  297.             ENDIF
  298.          ENDIF
  299.       ELSE              &&  EXIT or Menu Choice
  300.          DO CASE
  301.          CASE Mpt=15
  302.             SAVE SCREEN TO ButScrn
  303.             Do Msg24 with 'Menu Button for a prg call if you like.'
  304.             ans=Inkey(5)
  305.             RESTORE SCREEN FROM ButScrn
  306.          CASE GroupFlag(Mpt) = -1
  307.             KEYBOARD CHR(10)
  308.          CASE GroupFlag(Mpt) = -2
  309.             KEYBOARD CHR(27)
  310.          ENDCASE
  311.       ENDIF
  312.    ENDCASE
  313. ENDDO    &&  ------------------ Main Loop ---------------------------
  314.  
  315. * ---Closing operations.
  316. SET COLOR TO &ButtColor
  317. RESTORE SCREEN FROM ButtScrn
  318. Null = SYS(2002,1)        &&  Turn the cursor on       [Fox 2.1]
  319. RETURN
  320. * EOF: BTEST.PRG
  321.